SWAGOLX.EXE (c) 1993 GDSOFT ALL RIGHTS RESERVED 00011 TEXT FILE MANAGEMENT ROUTINES 1 05-28-9313:58ALL SWAG SUPPORT TEAM FASTIO.PAS IMPORT 10 GB>Could you Write a MCSEL ;-) wich gives us some hints For making Text i/oπ GB>_much_ faster ? I read that about the SetTextBuf although I never triedπ GB>it. What are other examples? Some little example-sources ?ππType BBTYP = ^BIGBUF;π BIGBUF = Array[0..32767] of Char;ππVar BUFFin : BBTYP; { general-use large Text I/O buffer }πVar BUFFOUT : BBTYP;π F : Text;π S : String;ππProcedure BBOPEN (Var F : Text; FN : String; OMODE : Char;π Var BP : BBTYP);πVar S : String;πbeginπ{$I-}π Assign (F,FN); New (BP); SetTextBuf (F,BP^);π Case UpCase(OMODE) ofπ 'R' : beginπ Reset (F); S := 'Input'π end;π 'W' : beginπ ReWrite (F); S := 'Output'π end;π 'A' : beginπ Append (F); S := 'Extend'π endπ elseπ end;π{$I+}π if Ioresult <> 0 thenπ beginπ Dispose (BP); FATAL ('Cannot open '+FN+' For '+S+' - Terminating')π endπend; { BBOPEN }ππto use:ππ BBOPEN (F,'myFile.txt',r,BUFFin);π While not Eof (F) doπ beginπ readln (F,S);π etc.π end;π Close (F); Dispose (BUFFin)π 2 05-28-9313:58ALL SWAG SUPPORT TEAM HEXDUMP.PAS IMPORT 90 { In the following message is a Complete Program I just wroteπ(including 3 routines from TeeCee's hints) which solves a particularπproblem I was having, but also demonstrates some things I see queriedπhere. So, there are a number of useful routines in it, as well as aπwhole Program which may help.π This Program dumps a Dos File to Hex and (modified) BCD. It isπpatterned after Vernon Buerg's LIST display (using Alt-H), which I findπuseful to look at binary Files. The problem is (was) I couldn't PrtScπthe screens, due to numerous special Characters which often hung myπPrinter. So, I wrote this Program to "dump" such Files to either theπPrinter or a Printer File. It substitutes an underscore For mostπspecial Characters (you can change this, of course).π note, too, that it demonstates the use of a C-like Character streamπi/o, which is a Variation of the "stream i/o" which is discussed here.πThis allows fast i/o of any Type of File, and could be modified toπprovide perFormant i/o For Text Files.π A number of the internal routines are a bit clumsy, since I had toπ(107 min left), (H)elp, More? make them "generic" For this post, rather than make use of after-marketπlibraries that I use (TTT, in my Case).π Enjoy!...π}ππProgram Hex_Dump; { Dump a File in Hex and BCD 930107 }πUses Crt, Dos, Printer;π{$M 8192,0,8192}π { Public Domain, by Mike Copeland and Trevor Carlsen 1993 }πConst VERSION = '1.1';π BSize = 32768; { Buffer Size }π ifLinE = 4; { InFormation Line }π PRLinE = 24; { Prompt Line }π ERLinE = 25; { Error Line }π DSLinE = 22; { Display Line }π PL = 1; { partial line o/p }π WL = 2; { whole line o/p }π B40 = ' ';πVar CP : Word; { Character Pointer }π BLKNO : Word; { Block # }π L,N : Word;π RES : Word;π LONG : LongInt;π NCP : LongInt; { # Characters Processed }π FSize : LongInt; { Computed File Size }π BV : Byte; { generic Byte Variable }π PRtoK : Boolean;π PFP : Boolean;π REGS : Registers;π PRTFile : String;π F1 : String;π MSTR,S1 : String;π PFV1 : Text;π F : File;π B : Array[0..BSize-1] of Byte;π CH : Char;ππProcedure WPROM (S : String); { generalized Prompt }πbeginπ GotoXY (1,PRLinE); Write (S); ClrEol; GotoXY (Length(S)+1,PRLinE);πend; { WPROM }ππProcedure CLEARBOT; { clear bottom of screen }πbeginπ GotoXY (1,PRLinE); ClrEol; GotoXY (1,ERLinE); ClrEolπend; { CLEARBOT }ππFunction GETYN : Char; { get Single-key response }πVar CH : Char;πbeginπ CH := UpCase(ReadKey); if CH = #0 then CH := ReadKey;π CLEARBOT; GETYN := CH;πend; { GETYN }ππProcedure PAUSE; { Generalized Pause processing }πVar CH : Char;πbeginπ WPROM ('Press any key to continue...'); CH := GETYNπend; { PAUSE }ππProcedure ERRor1 (S : String); { General Error process }πVar CH : Char;πbeginπ GotoXY (1,ERLinE); Write (^G,S); ClrEol; PAUSEπend; { ERRor1 }ππProcedure FATAL (S : String); { Fatal error - Terminate }πbeginπ ERRor1 (S); Haltπend; { FATAL }ππFunction TEStoNLinE : Byte; { Tests For Printer On Line }πVar REGS : Registers;πbeginπ With REGS doπ beginπ AH := 2; DX := 0;π Intr($17, Dos.Registers(REGS));π TEStoNLinE := AH;π endπend; { TEStoNLinE }ππFunction SYS_DATE : String; { Format System Date as YY/MM/DD }πVar S1, S2, S3 : String[2];πbeginπ REGS.AX := $2A00; { Function }π MsDos (Dos.Registers(REGS)); { fetch System Date }π With REGS doπ beginπ Str((CX mod 100):2,S1); Str(Hi(DX):2,S2); Str(Lo(DX):2,S3);π end;π if S2[1] = ' ' then S2[1] := '0'; { fill in blanks }π if S3[1] = ' ' then S3[1] := '0';π SYS_DATE := S1+'/'+S2+'/'+S3πend; { SYS_DATE }ππFunction SYS_TIME : String; { Format System Time }πVar S1, S2, S3 : String[2];πbeginπ REGS.AX := $2C00; { Function }π MsDos (Dos.Registers(REGS)); { fetch System Time }π With REGS doπ beginπ Str(Hi(CX):2,S1); Str(Lo(CX):2,S2); Str(Hi(DX):2,S3);π end;π if S2[1] = ' ' then S2[1] := '0'; { fill in blanks }π if S3[1] = ' ' then S3[1] := '0';π if S1[1] = ' ' then S1[1] := '0';π SYS_TIME := S1+':'+S2+':'+S3πend; { SYS_TIME }ππFunction EXISTS ( FN : String): Boolean; { test File existance }πVar F : SearchRec;πbeginπ FindFirst (FN,AnyFile,F); EXISTS := DosError = 0πend; { EXISTS }ππFunction UPPER (S : String) : String;πVar I : Integer;πbeginπ For I := 1 to Length(S) doπ S[I] := UpCase(S[I]);π UPPER := S;πend; { UPPER }ππProcedure SET_File (FN : String); { File Output For PRinT }πbeginπ PRTFile := FN; PFP := False; PRtoK := False;πend; { SET_File }ππProcedure PRinT_inIT (S : String); { Initialize Printer/File Output }πVar X,Y : Word;πbeginπ PRtoK := TestOnLine = 144; PFP := False; X := WhereX; Y := WhereY;π if PRtoK thenπ beginπ WPROM ('Printer is Online - do you wish Printer or File? (P/f) ');ππ if GETYN = 'F' then SET_File (S)π elseπ beginπ WPROM ('Please align Printer'); PAUSEπ endπ endπ else SET_File (S);π GotoXY (X,Y) { restore cursor }πend; { PRinT_inIT }ππFunction OPENF (Var FV : Text; FN : String; MODE : Char) : Boolean;πVar FLAG : Boolean;πbeginπ FLAG := True; { set default }π Assign (FV, FN); { allocate File }π Case UpCase(MODE) of { open mode }π 'W' : begin { output }π {$I-} ReWrite (FV); {$I+}π end;π 'R' : begin { input }π {$I-} Reset (FV); {$I+}π end;π 'A' : begin { input/extend }π {$I-} Append (FV); {$I+}π end;π elseπ end; { of Case }π if Ioresult <> 0 then { test For error on OPEN }π beginπ FLAG := False; { set Function result flag }π ERRor1 ('*** Unable to OPEN '+FN);π end;π OPENF := FLAG { set return value }πend; { OPENF }ππProcedure PRinT (inD : Integer; X : String); { Print Report Line }πVar AF : Char; { Append Flag }π XX,Y : Word;πbeginπ if PRtoK then { Printer online? }π beginπ Case inD of { what Type of print line? }π PL : Write (LST, X); { partial line }π WL : Writeln (LST, X); { whole line }π endπ end { Printer o/p }π else { use o/p File }π beginπ XX := WhereX; Y := WhereY;π if not PFP then { File not opened }π beginπ AF := 'W'; { default }π if EXISTS (PRTFile) thenπ beginπ WPROM ('** Print File '+PRTFile+' exists - Append to it? (Y/n) ');π if GETYN <> 'N' then AF := 'A';π end;π if OPENF (PFV1, PRTFile, AF) then PFP := True { set flag }π else FATAL ('*** Cannot Open Printer O/P File - Terminating');ππ end; { of if }π GotoXY (XX,Y); { restore cursor }π Case inD ofπ PL : Write (PFV1, X); { partial }π WL : Writeln (PFV1, X); { whole }π end;π end; { else }πend; { PRinT }ππFunction FSI (N : LongInt; W : Byte) : String; { LongInt->String }πVar S : String;πbeginπ if W > 0 then Str (N:W,S)π else Str (N,S);π FSI := S;πend; { FSI }ππProcedure CLOSEF (Var FYL : Text); { Close a File - open or not }πbeginπ{$I-} Close (FYL); {$I+} if Ioresult <> 0 then;πend; { CLOSEF }ππFunction CENTER (S : String; N : Byte): String; { center N Char line }πbeginπ CENTER := Copy(B40+B40,1,(N-Length(S)) Shr 1)+Sπend; { CENTER }ππProcedure SSL; { System Status Line }π{ This routine is just For "flash"; it can be omitted... }πConst DLM = #32#179#32;πbeginπ GotoXY (1,1); Write (F1+DLM+'Fsz: '+FSI(FSize,1)+DLM+π 'Blk: '+FSI(BLKNO,1)+DLM+π 'C# '+FSI(CP,1));πend; { SSL }ππ { The following 3 routines are by Trevor Carlsen }πFunction Byte2Hex(numb : Byte): String; { Byte to hex String }πConst HexChars : Array[0..15] of Char = '0123456789ABCDEF';πbeginπ Byte2Hex[0] := #2; Byte2Hex[1] := HexChars[numb shr 4];π Byte2Hex[2] := HexChars[numb and 15];πend; { Byte2Hex }ππFunction Numb2Hex(numb: Word): String; { Word to hex String.}πbeginπ Numb2Hex := Byte2Hex(hi(numb))+Byte2Hex(lo(numb));πend; { Numb2Hex }ππFunction Long2Hex(L: LongInt): String; { LongInt to hex String }πbeginπ Long2Hex := Numb2Hex(L shr 16) + Numb2Hex(L);πend; { Long2Hex }ππFunction GET_Byte: Byte; { fetch Byte from buffer data }πbeginπ GET_Byte := Byte(B[CP]); Inc (CP); Inc (NCP)πend; { GET_Byte }ππFunction EOS (Var FV : File): Boolean; { Eof on String File Function }πbeginπ if CP >= RES then { data still in buffer? }π if NCP < FSize thenπ begin { no - get new block }π BLKNO := (NCP div BSize);π FillChar(B,BSize,#0); { block to read }π Seek (F,BLKNO*BSize); BlockRead (F,B,BSize,RES); CP := 0;π endπ else RES := 0;π EOS := RES = 0;πend; { EOS }ππbeginπ ClrScr; GotoXY (1,2);π Write (CENTER('--- Hex Dump - Version '+VERSION+' ---',80));π if ParamCount > 0 then F1 := ParamStr(1)π elseπ beginπ WPROM ('Filename to be dumped: '); readln (F1); CLEARBOTπ end;π if not EXISTS (F1) then FATAL ('*** '+F1+' File not present - Terminating! ***');π PRinT_inIT ('HEXDUMP.TXT'); F1 := UPPER(F1);π PRinT (WL,CENTER('Hex Dump of '+F1+' '+SYS_DATE+' '+SYS_TIME,80));π Assign (F,F1); GotoXY (1,ifLinE); Write ('Processing ',F1);π Reset (F,1); FSize := FileSize(F); CP := BSize; NCP := 0; RES :=πBSize;π PRinT (WL,'offset Addr 1 2 3 4 5 6 7 8 9 10 A B C D E F 1234567890abcdef');π While not EOS (F) doπ beginπ if (NCP mod 16) = 0 thenπ beginπ if NCP > 0 thenπ beginπ PRinT (WL,MSTR+S1); SSLπ end;π MSTR := FSI(NCP,6)+' '+Numb2Hex(NCP); { offset & Address }π S1 := ' ';π end;π BV := GET_Byte; { fetch next Byte from buffer }π MSTR := MSTR+' '+Byte2Hex(BV); { Hex info }π if BV in [32..126] then S1 := S1+Chr(BV) { BCD info }π else S1 := S1+'_';π end;π Close (F);π While (NCP mod 16) > 0 doπ beginπ MSTR := MSTR+' '; Inc (NCP); { fill out last line }π end;π PRinT (WL,MSTR+S1); SSL; MSTR := 'Printer';π if PFP thenπ beginπ CLOSEF (PFV1); MSTR := PRTFileπ end;π GotoXY (1,ifLinE+1); Write ('Formatted output is on ',MSTR);π GotoXY (1,ERLinE); Write (CENTER('Finis...',80))πend.π 3 05-28-9313:58ALL SWAG SUPPORT TEAM LINE-CNT.PAS IMPORT 20 {π>I'm wondering if anyone can post me a source For another way toπ>find out the max lines in a Text File.π}ππ {.$DEFinE DebugMode}ππ {$ifDEF DebugMode}ππ {$A+,B-,D+,E-,F-,G+,I+,L+,N-,O-,P-,Q+,R+,S+,T+,V+,X-}ππ {$else}ππ {$A+,B-,D-,E-,F-,G+,I-,L-,N-,O-,P-,Q-,R-,S-,T-,V-,X-}ππ {$endif}ππ {$M 1024,0,0}ππProgram LineCounter;ππConstπ co_LineFeed = 10;ππTypeπ byar_60K = Array[1..61440] of Byte;ππVarπ wo_Index,π wo_BytesRead : Word;ππ lo_FileSize,π lo_BytesProc,π lo_LineCount : LongInt;ππ fi_Temp : File;ππ byar_Buffer : byar_60K;ππbeginπ (* Attempt to open TEST.doC File. *)π assign(fi_Temp, 'linecnt.pas');π {$I-}π reset(fi_Temp, 1);π {$I+}ππ (* Check if attempt was sucessful. *)π if (ioresult <> 0) thenπ beginπ Writeln('ERRor opening TEST.doC File');π haltπ end;ππ (* Record the size in Bytes of TEST.doC . *)π lo_FileSize := Filesize(fi_Temp);ππ (* Initialize Variables. *)π lo_LineCount := 0;π lo_BytesProc := 0;ππ (* Repeat Until entire File has been processed. *)π Repeatπ (* Read in all or a 60K chunk of TEST.doC into the *)π (* "buffer" For processing. *)π blockread(fi_Temp, byar_Buffer, sizeof(byar_60K), wo_BytesRead);ππ (* Count the number of line-feed Characters in the *)π (* "buffer". *)π For wo_Index := 1 to wo_BytesRead doπ if (byar_Buffer[wo_Index] = co_LineFeed) thenπ inc(lo_LineCount);ππ (* Record the number of line-feeds found in the buffer. *)π inc(lo_BytesProc, wo_BytesRead)ππ Until (lo_BytesProc = lo_FileSize);ππ (* Close the TEST.doC File. *)π close(fi_Temp);ππ (* Display the results. *)π Writeln(' total number of lines in LinECNT.PAS = ', lo_LineCount)ππend.π{π ...to find a specific line, you'll have to process the Text File upπ to the line you are after, then use a "seek" so that you can readπ in just this line into a String Variable. (You'll have to determineπ the length of the String, and then set the String's length-Byte.)π} 4 05-28-9313:58ALL SWAG SUPPORT TEAM LISTER.PAS IMPORT 63 { Right now I'm writing an interpreter For a language that Iπdeveloped, called "Isaac". (It's Physics oriented). I'd be veryπinterested in you publishing this inFormation regarding PascalπCompilers, though I would likely not have time to do the excercisesπright away.ππ Ok, Gavin. I'll post the lister (not Really anything exceptional,π but it'll get this thing going in Case anyone joins in late.)ππ Here's the lister Program:π}π{$I-}πProgram Lister;ππUses Dos;ππ{$I PTypeS.inC}π{Loacted in the SOURCE\MISC Directory.}ππFunction LeadingZero(w:Word): String;{convert Word to String With 0's}π Var s :String;π beginπ Str(w:0,s);π if Length(s) < 2 then s := '0'+s;π LeadingZero := s;π if Length(s) > 2 then Delete(s,1,Length(s)-2);π end;πππFunction FormatDate :String; { get system date and pretty it up }π Constπ months : Array[1..12] of String[9] =π ('January', 'February', 'March', 'April', 'May', 'June', 'July',π 'August', 'September', 'October', 'November', 'December');π Var s1,fn : String; y,m,d,dow : Word;π beginπ GetDate(y,m,d,dow);π s1 := leadingZero(y);π fn := LeadingZero(d);π s1 := fn+' '+s1;π fn := months[m];π s1 := fn+' '+s1;π FormatDate := s1;π end;ππFunction FormatTime :String; { get system time and pretty it up }π Var s1, fn : String; h,m,s,s100 : Word;π beginπ GetTime(h,m,s,s100);π fn := LeadingZero(h);π s1 := fn+':';π fn := LeadingZero(m);π FormatTime := s1+fn;π end;ππProcedure Init(name:String);π Var t,d :String;π beginπ line_num := 0; page_num := 0; level := 0;π line_count := MAX_LinES_PER_PAGE;π source_name := name;π Assign(F1, name); { open sourceFile - terminate if error }π Reset(F1);π if Ioresult>0 thenπ beginπ Writeln('File error!');π Halt(1);π end;π { set date/time String }π d := FormatDate;π t := FormatTime;π date := d+' '+t;π end;ππProcedure Print_Header;π Var s, s1 :String;π beginπ Writeln(F_FEED);π Inc(page_num);π Str(page_num, s1);π s := 'Page '+s1+' '+source_name+' '+date;π Writeln(s);π end;ππProcedure PrintLine(line :String);π beginπ Inc(line_count);π if line_count>MAX_LinES_PER_PAGE thenπ beginπ print_header;π line_count := 1;π end;π if ord(line[0])>MAX_PRinTLinE_LEN thenπ line[0] := Chr(MAX_PRinTLinE_LEN);π Writeln(line);π end;πππFunction GetSourceLine :Boolean;π Var print_buffer :String[MAX_SOURCELinE_LEN+9];π s :String;π beginπ if not(Eof(F1)) then beginπ Readln(F1, source_buffer);π Inc(line_num);π Str(line_num:4, s);π print_buffer := s+' ';π Str(level, s);π print_buffer := print_buffer+s+': '+source_buffer;π PrintLine(print_buffer);π GetSourceLine := True;π end else GetSourceLine := False;π end;πππbegin { main }π if ParamCount=0 then beginπ Writeln('Syntax: LISTER <Filename>');π Halt(2);π end;π init(ParamStr(1));π While GetSourceLine do;πend.ππ{π Now that the task of producing a source listing is taken care of,π we can tackle the scanners main business: scanning. Our next jobπ is to produce a scanner that, With minor changes, will serve usπ For the rest of this "course".ππ The SCANNER will do the following tasks:ππ ° scan Words, numbers, Strings and special Characters.π ° determine the value of a number.π ° recognize RESERVED WordS.ππ LOOKinG For toKENSππ SCANNinG is reading the sourceFile and breaking up the Text of aπ Program into it's language Components; such as Words, numbers,π and special symbols. These Components are called toKENS.ππ You want to extract each each token, in turn, from the sourceπ buffer and place it's Characters into an empty Array, eg.π token_String.ππ At the start of a Word token, you fetch it's first Character andπ each subsequent Character from the source buffer, appending eachπ Character to the contents of token_String. As soon as you fetch aπ Character that is not a LETTER, you stop. All the letters inπ token_String make up the Word token.ππ Similarly, at the start of a NUMBER token, you fetch the firstπ digit and each subsequent digit from the source buffer. Youπ append each digit to the contents of token_String. As soon as youπ fetch a Character that is not a DIGIT, you stop. All digitsπ within token_String make up the number token.ππ Once you are done extracting a token, you have the firstπ Character after a token. This Character tells you that you haveπ finished extracting the token. if the Character is blank, youπ skip it and any subsequent blanks Until you are again looking atπ a nonblank Character. This Character is the start of the nextπ token.ππ You extract the next token in the same way you extracted theπ previous one. This process continues Until all the tokens haveπ been extracted from the source buffer. Between extracting tokens,π you must reset token_String to null String to prepare it For theπ next token.ππ PASCAL toKENSππ A scanner For a pascal Compiler must, of course, recognize Pascalπ tokens. The Pascal language contains several Types of tokens:π identifiers, reserved Words, numbers, Strings, and specialπ symbols.ππ This next exercise is a toKENIZER that recognizes a limitedπ subset of Pascal tokens. The Program will read a source File andπ list all the tokens it finds. This first version will recognizeπ only Words, numbers, and the Pascal "end-of-File" period - but itπ provides the foundation upon which we will build a full Pascalπ scanner in the second version.ππ Word: A Pascal Word is made up of a LETTER followed by any numberπ of LETTERS and DIGITS (including 0).ππ NUMBER: For now, we'll restrict a number token to a Pascalπ unsigned Integer, which is one or more consecutive digits. (We'llπ handle signs, decimals, fractions, and exponents later) and,π we'll use the rule that an input File *must* have a period asπ it's last token.ππ The tokenizer will print it's output in the source listing.ππ EXERCISE #2ππ Use the following TypeS and ConstANTS to create a SCANNER asπ described above:ππ-------------------------------------------------------------------ππTypeπ Char_code = (LETTER, DIGIT, SPECIAL, Eof_CODE);π token_code = (NO_toKEN, Word, NUMBER, PERIOD,π end_of_File, ERRor);π symb_Strings :Array[token_code] of String[13] =π ('<no token>','<Word>','<NUMBER>','<PERIOD>',π '<end of File>','<ERRor>');ππ literal_Type = (Integer_LIT, String_LIT);ππ litrec = Recordπ l :LITERAL_Type;π Case l ofππ Integer_LIT: value :Integer;π String_LIT: value :String;π end;π end;ππConstπ Eof_Char = #$7F;ππVarπ ch :Char; {current input Char}π token :token_code; {code of current token}π literal :litrec; {value of current literal}π digit_count :Integer; {number of digits in number}π count_error :Boolean; {too many digits in number?}π Char_table :Array[0..255] of Char_code;{ascii Character map}πππThe following code initializes the Character map table:ππFor c := 0 to 255 doπ Char_table[c] := SPECIAL;πFor c := ord('0') to ord('9') doπ Char_table[c] := DIGIT;πFor c := ord('A') to ord('Z') doπ Char_table[c] := LETTER;πFor c:= ord('a') ro ord('z') doπ Char_table[c] := LETTER;πChar_table[ord(Eof_Char)] := Eof_CODE;ππ-------------------------------------------------------------------ππ You can (and should) use the code from your source listingπ Program to start your scanner. if you have just arrived, use myπ own code posted just previously.ππ 5 05-28-9313:58ALL SWAG SUPPORT TEAM LONGLINE.PAS IMPORT 16 Program longline;ππVarπ LinePart: String;π InFile, OutFile: Text;π Index1, Index2: Word;π Result: Byte;ππbegin { First create a test File With lines longer than }π { 255 caracters, this routine will generate lines in }π { exess of 600 caracters. The last "EOLN" at the end }π { is a visual aid to check that the Complete line has }π { been copied to the output File. }ππ Assign (OutFile, 'InFile.txt');π ReWrite (OutFile);π Randomize;π For Index1 := 1 to 100 do beginπ For Index2 := 1 to (Random (5) + 1) doπ Write (OutFile, 'These are some very long Text Strings that'π + ' are written to the File InFile.txt in order to test' +π ' the capability of reading verylong Text lines. Lines' +π ' that even exceed Turbo Pascal''s limit of 255' +π ' caracters per String');π Writeln (OutFile, 'EOLN');π end;π Close (OutFile);ππ { Now re-open it and copy InFile.txt to OutFile.txt }π Assign (InFile, 'InFile.txt');π Assign (OutFile, 'OutFile.txt');π Reset (InFile);π ReWrite (OutFile);ππ While not Eof (InFile) do beginπ While not Eoln (InFile) do beginππ { While we are not at enf-of-line, read 255 }π { caracters notice we use READ instead of READLN }π { because the latter would skip to the next line even }π { if data was still left on this line.}ππ Read (InFile, LinePart);π Result := Ioresult;π Writeln ('Result was ', Result);π Write (OutFile, LinePart);π end;ππ { We have reached end-of-Line so do a readln to skip }π { to the start of the next line.}ππ Readln (InFile);ππ { Also Writeln to output File so it to, skips to the }π { next line. }ππ Writeln (OutFile);ππ end;ππ { Close both Files }ππ Close (OutFile);π Close (InFile);πend.ππ 6 05-28-9313:58ALL SWAG SUPPORT TEAM PTYPES.INC IMPORT 5 {--PTYPES.INC-----------------------------------------------------------π}π{ Type and Constant decalarations }ππCONSTπ MAX_FILENAME_LEN = 32;π MAX_SOURCELINE_LEN = 246;π MAX_PRINTLINE_LEN = 80;π MAX_LINES_PER_PAGE = 50;π DATE_STRING_LENGTH = 26;π F_FEED = #12;ππVARπ line_num, page_num,π level, line_count :word;ππ source_buffer :string[MAX_SOURCELINE_LEN];π source_name :string[MAX_FILENAME_LEN];π date :string[DATE_STRING_LENGTH];π F1 :text;ππ 7 05-28-9313:58ALL SWAG SUPPORT TEAM READFILE.PAS IMPORT 47 {π Could somebody post some source code on how to read in a config File? andπ also have it ignore lines that start With the semicolon. Sorta like thisπ one:ππSure do, here is mine. I have to include quite a couple of other Functions asπthey are used in the readcfg. I included one 'block' as an example in whichπyou read in a particular keyWord (named: 'keyWord') and find the parammeterπwhich follows. You can duplicate this block as many times as you like.πAlthough it scans the whole File again, it's pretty fast as it does it inπmemory.π}πFunction Trim(S : String) : String;π {Return a String With leading and trailing white space removed}πVarπ I : Word;π SLen : Byte Absolute S;πbeginπ While (SLen > 0) and (S[SLen] <= ' ') doπ Dec(SLen);π I := 1;π While (I <= SLen) and (S[I] <= ' ') doπ Inc(I);π Dec(I);π if I > 0 thenπ Delete(S, 1, I);π Trim := S;πend;πππ{******************************************************}πFunction StrUpper(Str: String): String; Assembler;π Asmπ jmp @Start { Jump over Table declared in the Code Segment }ππ @Table:π { Characters from ASCII 0 --> ASCII 96 stay the same }π DB 00,01,02,03,04,05,06,07,08,09,10,11,12,13,14,15,16,17,18,19,20,21π DB 22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39,40,41,42,43π DB 44,45,46,47,48,49,50,51,52,53,54,55,56,57,58,59,60,61,62,63,64,65π DB 66,67,68,69,70,71,72,73,74,75,76,77,78,79,80,81,82,83,84,85,86,87π DB 88,89,90,91,92,93,94,95,96π { Characters from ASCII 97 "a" --> ASCII 122 "z" get translated }π { to Characters ASCII 65 "A" --> ASCII 90 "Z" }π DB 65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,80,81,82,83,84,85,86π DB 87,88,89,90π { Characters from ASCII 123 --> ASCII 127 stay the same }π DB 123,124,125,126,127π { Characters from ASCII 128 --> ASCII 165 some changesπ #129 --> #154, #130 --> #144, #132 --> #142, #134 --> #143π #135 --> #128, #145 --> #146, #148 --> #153, #164 --> #165}ππ DB 128,154,144,131,142,133,143,128,136,137,138,139,140,141,142,143π DB 144,146,146,147,153,149,150,151,152,153,154,155,156,157,158,159π DB 160,161,162,163,165,165π { Characters from ASCII 166 --> ASCII 255 stay the same }π DB 166,167,168,169,170,171,172,173,174,175,176,177,178,179,180,181π DB 182,183,184,185,186,187,188,189,190,191,192,193,194,195,196,197π DB 198,199,200,201,202,203,204,205,206,207,208,209,210,211,212,213π DB 214,215,216,217,218,219,220,221,222,223,224,225,226,227,228,229π DB 230,231,232,233,234,235,236,237,238,239,240,241,242,243,244,245π DB 246,247,248,249,250,251,252,253,254,255ππ @Start:π push DS { Save Turbo's Data Segment address }π lds SI,Str { DS:SI points to Str[0] }π les DI,@Result { ES:DI points to StrUpper[0] }π cld { Set direction to Forward }π xor CX,CX { CX = 0 }π mov BX,ofFSET @Table { BX = offset address of LookUpTable }π lodsb { AL = Length(Str); SI -> Str[1] }π mov CL,AL { CL = Length(Str) }π stosb { Move Length(Str) to Length(StrUpper) }π jcxz @Exit { Get out if Length(Str) is zero }ππ @GetNext:π lodsb { Load next Character into AL }π segcs XLAT { Translate Char using the LookupTable }π { located in Code Segment at offset BX }π stosb { Save next translated Char in StrUpper}π loop @GetNext { Get next Character }ππ @Exit:π pop DS { Restore Turbo's Data Segment address }πend {StrUpper};π{-----------------------------------------------------------------}πFunction MCS(element,line:String):Integer;ππ{Returns the position of an element in a line.π Returns zero if no match found.π Example: line:='abcdefg'π i:=MCS('bc',line) would make i=2π MCS is not Case sensitive}ππbeginπ MCS:=pos(StrUpper(element),StrUpper(line));πend;ππFunction getparameter(element,line:String;pos:Integer):String;π{This Function is called With 'pos' already indexed after the command Word inπa line. It searches For the Word(s) after the command Word in the rest ofπthe line, up to the end of the line or Until a ; is encountered}ππVarπ n,b,e,l:Byte;ππbeginπ n:=pos+length(element);π {places n-index just after keyWord}ππ While (line[n]=' ') doπ inc(n); {increment line[n] over spaces}π b:=n; l:=length(line);π While (n<=l) doπ beginπ if line[n]<>';' thenπ beginπ inc(n);π e:=n;π endπ elseπ beginπ e:=n;π n:=l+1;π end;π end;π getparameter:=trim(copy(line,b,e-b));ππend;ππProcedure ReadCfg(name:String); {'name' is Filename to read in}πTypeπ Line = String[80];π Lines = Array[0..799] of Line;π LinesP = ^Lines;πVarπ TextBuf : LinesP;π TextFile : Text;π Index,Number:Integer;π buffer:Array[1..2048] of Char;π s:line;π s1:line;π n:Byte;π i:Integer;πbeginπ assign( TextFile, name );π reset( TextFile );π SetTextBuf(TextFile,Buffer);π Index := 0;π new(TextBuf);ππ While not eof( TextFile) doπ {Read the Text File into heap memory}π beginπ readln( TextFile,s);π if s[1]<>';' then if s<>'' thenπ beginπ TextBuf^[Index]:=s;π inc( Index )π end;π end;π close( TextFile );ππ{********begin of "find a keyWord" block***********}π Number := Index -1;π For Index := 0 to Number doπ beginπ s:=( TextBuf^[ Index ]);π n:=MCS('BoardNo',s);π if n > 0 thenπ beginπ s1:=getparameter('KeyWord',s,n);π {do other things With found 'keyWord'}π end;π end;π{end of "find a keyWord" block}ππ dispose( TextBuf); {release heap memory}πend;π 8 05-28-9313:58ALL SWAG SUPPORT TEAM READTEXT.PAS IMPORT 57 {$A+,B-,D-,E+,F-,I+,L-,N-,O-,R+,S-,V-}π{$M 4048,65536,655360}ππProgram ReadText;ππ{ Author Trevor J Carlsen - released into the public domain 1991 }π{ PO Box 568 }π{ Port Hedland }π{ Western Australia 6721 }π{ Voice +61 91 73 2026 Data +61 91 73 2569 }π{ FidoNet 3:690/644 }ππ{ This example Programs displays a Text File using simple Word wrap. The }π{ cursor keys are used to page Forward or backwards by page or by line. }π{ The Program makes some important assumptions. The main one is that no }π{ line in the File will ever exceed 255 Characters in length. to get }π{ around this restriction the ReadTxtLine Function would need to be }π{ rewritten. }ππ{ The other major restriction is that Files exceeding a size able to be }π{ totally placed in RAM cannot be viewed. }ππ{$DEFinE TurboPower (Remove the period if you have Turbo Power's TPro) }ππUsesπ {$ifDEF TurboPower }π tpCrt,π colordef;π {$else}π Crt;π {$endif}ππConstπ {$ifNDEF TurboPower }π BlackOnLtGray = $70; LtGrayOnBlue = $17;π {$endif}π LineLength = 79; MaxLines = 6000;π ScreenLines = 22; escape = $011b;π Home = $4700; _end = $4f00;π upArrow = $4800; downArrow = $5000;π PageUp = $4900; PageDown = $5100;ππTypeπ LineStr = String[Linelength];π StrPtr = ^LineStr;ππVarπ TxtFile : Text;π Lines : Array[1..MaxLines] of StrPtr;π NumberLines: 1..MaxLines+1;π CurrentLine: 1..MaxLines+1-ScreenLines;π st : String;π finished : Boolean;π OldExitProc: Pointer;π TxtBuffer : Array[0..16383] of Byte;π OldAttr : Byte;ππFunction LastPos(ch : Char; S : String): Byte;π { Returns the last position of ch in S or zero if ch not in S }π Varπ x : Word;π len : Byte Absolute S;π beginπ x := succ(len);π Repeatπ dec(x);π Until (x = 0) or (S[x] = ch);π LastPos := x;π end; { LastPos }ππFunction Wrap(Var S,CarryOver: String): String;π { Returns a String of maximum length Linelength from S. Any additional }π { Characters remaining are placed into CarryOver. }π Constπ space = #32;π Varπ temp : String;π LastSpace : Byte;π len : Byte Absolute S;π beginπ FillChar(temp,sizeof(temp),32);π temp := S; CarryOver := ''; wrap := temp;π if length(temp) > LineLength then beginπ LastSpace := LastPos(space,copy(temp,1,LineLength+1));π if LastSpace <> 0 then beginπ Wrap[0] := chr(LastSpace - 1);π CarryOver := copy(temp,LastSpace + 1, 255)π end { if LastSpace... }π else beginπ Wrap[0] := chr(len);π CarryOver := copy(temp,len,255);π end; { else }π end; { if (length(S))...}π end; { Wrap }ππFunction ReadTxtLine(Var f: Text; L: Byte): String;π Varπ temp : String;π len : Byte Absolute temp;π done : Boolean;π beginπ len := 0; done := False;π {$I-}π While not eoln(f) do beginπ read(f,temp);π if Ioresult <> 0 then beginπ Writeln('Error reading File - aborted');π halt;π end;π end; { While }π if eoln(f) then readln(f);π ReadTxtLine := st + Wrap(temp,st);π finished := eof(f);π end; { ReadTxtLine }ππProcedure ReadTxtFile(Var f: Text);π Varπ x : Word;π beginπ st := '';π NumberLines := 1;π Repeatπ if NumberLines > MaxLines then beginπ Writeln('File too big');π halt;π end;π if (MaxAvail >= Sizeof(LineStr)) thenπ new(Lines[NumberLines])π else beginπ Writeln('Insufficient memory');π halt;π end;π FillChar(Lines[NumberLines]^,LineLength+1,32);π if length(st) > LineLength thenπ Lines[NumberLines]^ := wrap(st,st)π else if length(st) <> 0 then beginπ Lines[NumberLines]^ := st;π st := '';π end elseπ Lines[NumberLines]^ := ReadTxtLine(f,LineLength+1);π Lines[NumberLines]^[0] := chr(LineLength);π if not finished thenπ inc(NumberLines);π Until finished;π end; { ReadTxtFile }ππProcedure DisplayScreen(line: Word);π Varπ x : Byte;π beginπ GotoXY(1,1);π For x := 1 to ScreenLines - 1 doπ Writeln(Lines[x-1+line]^);π Write(Lines[x+line]^)π end;ππProcedure PreviousPage;π beginπ if CurrentLine > ScreenLines thenπ dec(CurrentLine,ScreenLines-1)π elseπ CurrentLine := 1;π end; { PreviousPage }ππProcedure NextPage;π beginπ if CurrentLine < (succ(NumberLines) - ScreenLines * 2) thenπ inc(CurrentLine,ScreenLines-1)π elseπ CurrentLine := succ(NumberLines) - ScreenLines;π end; { NextPage }ππProcedure PreviousLine;π beginπ if CurrentLine > 1 thenπ dec(CurrentLine)π elseπ CurrentLine := 1;π end; { PreviousLine }ππProcedure NextLine;π beginπ if CurrentLine < (succ(NumberLines) - ScreenLines) thenπ inc(CurrentLine)π elseπ CurrentLine := succ(NumberLines) - ScreenLines;π end; { NextLine }ππProcedure StartofFile;π beginπ CurrentLine := 1;π end; { StartofFile }ππProcedure endofFile;π beginπ CurrentLine := succ(NumberLines) - ScreenLines;π end; { endofFile }ππProcedure DisplayFile;ππ Function KeyWord : Word; Assembler;π Asmπ mov ah,0π int 16hπ end;ππ beginπ DisplayScreen(CurrentLine);π Repeatπ Case KeyWord ofπ PageUp : PreviousPage;π PageDown : NextPage;π UpArrow : PreviousLine;π DownArrow : NextLine;π Home : StartofFile;π _end : endofFile;π Escape : halt;π end; { Case }π DisplayScreen(CurrentLine);π Until False;π end; { DisplayFile }ππProcedure NewExitProc;Far;π beginπ ExitProc := OldExitProc;π {$ifDEF TurboPower}π NormalCursor;π {$endif}π Window(1,1,80,25);π TextAttr := OldAttr;π ClrScr;π end;ππProcedure Initialise;π beginπ CurrentLine := 1;π if ParamCount <> 1 then beginπ Writeln('No File name parameter');π halt;π end;π OldAttr := TextAttr;π assign(TxtFile,Paramstr(1));π {$I-} reset(TxtFile);π if Ioresult <> 0 then beginπ Writeln('Unable to open ',Paramstr(1));π halt;π end;π SetTextBuf(TxtFile,TxtBuffer);π Window(1,23,80,25);π TextAttr := BlackOnCyan;π ClrScr;π Writeln(' Next Page = [PageDown] Previous Page = [PageUp]');π Writeln(' Next Line = [DownArrow] Previous Line = [UpArrow]');π Write(' Start of File = [Home] end of File = [end] Quit = [Escape]');π Window(1,1,80,22);π TextAttr := LtGrayOnBlue;π ClrScr;π {$ifDEF TurboPower}π HiddenCursor;π {$endif}π OldExitProc := ExitProc;π ExitProc := @NewExitProc;π end;ππbeginπ Initialise;π ReadTxtFile(TxtFile);π DisplayFile;πend.ππππ 9 05-28-9313:58ALL SWAG SUPPORT TEAM SCROLLER.PAS IMPORT 18 {πERIC MILLERπread a Text File and scrollπ}ππUsesπ Crt;ππConstπ MaxLine = 200;π MaxLength = 80;ππVarπ Lines : Array [1..MaxLine] of String[MaxLength];π OldLine,π L,π CurrentLine,π NumLines : Word;π TextFile : Text;π Key : Char;π Redraw,π Done : Boolean;ππbeginπ ClrScr;π Assign(TextFile, 'MCGALIB.PAS');π Reset(TextFile);π NumLines := 0;π While not EOF(TextFile) and (NumLines < MaxLine) DOπ beginπ Inc(NumLines);π Readln(TextFile, Lines[NumLines]);π end;π Close(TextFile);ππ{π Well...that handles getting the File into memory...butπ to scroll through using Up/Down & PgUp PgDn is a lot harder,π but not incredibly difficult.π}π Done := False;π Redraw := True;π CurrentLine := 1;ππ While not Done DOπ beginπ if Redraw thenπ beginπ GotoXY(1,1);π For L := CurrentLine to CurrentLine + 22 DOπ Write(Lines[L], ' ':(80-Length(Lines[L])));π Redraw := False;π end;π Key := ReadKey;π Case Key ofπ #0:π begin { cursor/page keys }π OldLine := CurrentLine;π Key := ReadKey;ππ Case Key ofπ #72: { up }π if CurrentLine > 1 thenπ Dec(CurrentLine);π #80: { down }π if CurrentLine < (NumLines-22) thenπ Inc(CurrentLine);π #73: { page up }π if CurrentLine > 23 thenπ Dec(CurrentLine, 23)π elseπ CurrentLine := 1;π #81: { page down }π if CurrentLine < (NumLines-44) thenπ Inc(CurrentLine, 23)π elseπ CurrentLine := NumLines-22;π end;ππ if CurrentLine <> OldLine thenπ Redraw := True;π end;ππ #27: Done := True;ππ end; {Case}π end; {begin}πend. {Program}ππ{πThat should work For scrolling through the lines. Sorryπ'bout not commenting the code alot; it is almost self-explanatoryπthough. But it works! You could optimize it For larger Filesπby using an Array of Pointers to Strings. But enough For now.π} 10 05-28-9313:58ALL SWAG SUPPORT TEAM TEXTUNIT.PAS IMPORT 38 Unit TextUtil;π{ Written by Wilbert Van.Leijen and posted in the Pascal Echo }ππInterfaceππFunction TextFilePos(Var f : Text) : LongInt;πFunction TextFileSize(Var f : Text) : LongInt;πProcedure TextSeek(Var f : Text; n : LongInt);ππImplementationπUses Dos;ππ{$R-,S- }ππProcedure GetFileMode; Assembler;ππAsmπ CLCπ CMP ES:[DI].TextRec.Mode, fmInputπ JE @1π MOV [InOutRes], 104 { 'File not opened For reading' }π xor AX, AX { Zero out Function result }π xor DX, DXπ STCπ@1:πend; { GetFileMode }ππFunction TextFilePos(Var f : Text) : LongInt; Assembler;ππAsmπ LES DI, fπ CALL GetFileModeπ JC @1ππ xor CX, CX { Get position of File Pointer }π xor DX, DXπ MOV BX, ES:[DI].TextRec.handleπ MOV AX, 4201hπ inT 21h { offset := offset-Bufend+BufPos }π xor BX, BXπ SUB AX, ES:[DI].TextRec.Bufendπ SBB DX, BXπ ADD AX, ES:[DI].TextRec.BufPosπ ADC DX, BXπ@1:πend; { TextFilePos }πππFunction TextFileSize(Var f : Text) : LongInt; Assembler;ππAsmπ LES DI, fπ CALL GetFileModeπ JC @1ππ xor CX, CX { Get position of File Pointer }π xor DX, DXπ MOV BX, ES:[DI].TextRec.handleπ MOV AX, 4201hπ inT 21hπ PUSH DX { Save current offset on the stack }π PUSH AXπ xor DX, DX { Move File Pointer to Eof }π MOV AX, 4202hπ inT 21hπ POP SIπ POP CXπ PUSH DX { Save Eof position }π PUSH AXπ MOV DX, SI { Restore old offset }π MOV AX, 4200hπ inT 21hπ POP AX { Return result}π POP DXπ@1:πend; { TextFileSize }ππProcedure TextSeek(Var f : Text; n : LongInt); Assembler;ππAsmπ LES DI, fπ CALL GetFileModeπ JC @2ππ MOV CX, Word Ptr n+2 { Move File Pointer }π MOV DX, Word Ptr nπ MOV BX, ES:[DI].TextRec.Handleπ MOV AX, 4200hπ inT 21hπ JNC @1 { Carry flag = reading past Eof }π MOV [InOutRes], AXπ JMP @2π { Force read next time }π@1: MOV AX, ES:[DI].TextRec.Bufendπ MOV ES:[DI].TextRec.BufPos, AXπ@2:πend; { TextSeek }πend. { TextUtil }ππ{ With the aid of that Unit you could save the position of each lineπin the Text File to an Array of LongInt as you read them. You can alsoπopen a temporary File, a File of LongInt, where each Record would simplyπrepresent the offset of that line in the Text File. if you need to goπback in the Text, simply read the offset of the line where you which toπrestart reading. Suppose you are on line 391 and you decide to go backπsay, 100 lines, simply do a Seek(MyIndex, CurrentLine-100). then use theπTextSeek Procedure to seek to that position in the Text File and startπreading again, taking into acount that you allready read those lines soπyou either re-Write the offsets to your index File, which won't hurtπsince you will just be overwriting the Records With the same valuesπagain or simply skip writing the offsets Until you reach a point whereπNEW lines that haven't yet been read are reached. Save any new offset asπyou read Forward.ππ With this method you can go back-wards as well as Forwards. In factπif you first read the File, saving all offsets Until the end, you canπoffer the user to seek to any line number.ππ When you read new lines or seek backwards, simply flush any linesπfrom memory. or maybe you could decide to keep a predetermined number ofπlines in memory say 300. When ever the user asks to read Forward orπbackwards, simply flush the 100 first or Last line, depending on theπdirection the user wants to go, and read 100 new lines from the TextπFile.ππ Maybe the best approach to be sure of sufficient memory is toπdetermine how many lines will fit. Suppose you limit line lengths to 255πcaracters. Determine how many will fit in a worse Case scenario. Createπas many 255 caracter Strings as will fit. divide that number of lines byπ4. Say you managed to create 1000 Strings of 255 caracters. divided by 4πis 250. So set a limit to 750 Strings to be safe and make any diskπaccesses in bundles of 250 Lines.ππ You can also keep the line offsets in memory in Arrays but you willπbe limited to 65520 / 8 = 16380 lines. Make that two Arrays stored onπthe heap and you've got yourself enough space to store 32760 lineπoffsets which at 255 caracters by line would be an 8.3 Meg File.π } 11 05-28-9313:58ALL SWAG SUPPORT TEAM VIEWER.PAS IMPORT 25 {π│I would like to be able to read a standard ASCII Text File from disk intoπ│a section of memory so I would be able to call up the screen later. Howπ│would I accomplish this? I'm assuming that once I have it in memory I couldπ│copy the information into $B800 and so have it display on the screen. Thisπ│would actually be useful For an instruction screen so I could scroll oneπ│screenful at a time With PgDn.ππSample code For viewing Text File. Feel free to experiment With it. If youπhave any questions, just ask.π}ππUsesπ Crt, Dos;πππProcedure ViewTextFile(fname: String);π{ fname - name of Text File to display }ππConstπ Bad = #255;π Null = #0;π ESC = #27;π Home = #71;π PgUp = #73;π PgDn = #81;π Done : Boolean = False;π PageIndex: Word = 1; { index to our screen/page }ππVarπ InFile : File; { unTyped File }π PFile : Pointer; { Pointer to our heap area }π Size, { size of File }π Result, { return code For BlockRead }π FileSeg, { Segment address of File in heap }π off: Word; { use as offset to our heap }π Pages: Array[1..2000] of Word; { define screen as Array of Words }π ch: Char; { For reading commands }ππbeginπ Assign(InFile, fname);π {$I-} Reset(InFile, 1); {$I+}π if IOResult <> 0 thenπ beginπ Writeln('File not found: ',fname);π Halt(1) { stop Program & return to Dos }π end;π Size := FileSize(InFile); { get size of File }π GetMem(PFile, Size); { allocate space in heap }π FileSeg := Seg(PFile^); { get Segment address of File in heap }ππ BlockRead(InFile, PFile^, Size, Result); { use BlockRead For fast File I/O }π FillChar(Pages, SizeOf(Pages), 0); { fill page With zeroes--ie:blank }π Repeatπ ClrScr;π off := Pages[PageIndex];π Repeat { display screenfull at a time }π Write(Chr(Mem[FileSeg:off]));π inc(off);π Until (off = Size) or (WhereY = 25);π Repeat { inner event loop }π ch := ReadKey;π if ch = ESC thenπ Done := True { user escaped }π elseπ if ch = Null thenπ Case ReadKey ofπ Home: PageIndex := 1; { go to first page }π PgUp: if PageIndex > 1 thenπ Dec(PageIndex);π PgDn: if off < Size thenπ beginπ Inc(PageIndex);π Pages[PageIndex] := off;π endπ elseπ ch := Badπ end;π Until (ch = Null) or Done;π Until Done;π Close(InFile) { don't forget to close the File }πend; { DisplayTextFile }πππbeginπ if ParamCount > 0 thenπ ViewTextFile(ParamStr(1))π elseπ Writeln('Error: Missing File parameter.')πend. { program }ππ
